home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload Trio 2
/
Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO
/
dir30
/
heaven_1.zip
/
DDDIST.LSP
< prev
next >
Wrap
Lisp/Scheme
|
1993-08-29
|
5KB
|
176 lines
;;╔══════════════════════════════════════════════════════════════════════════╗
;;║Program name: DDDIST.LSP ║
;;║Initial Author: Michael Jenkins ║
;;║Description: This is a dialog box for obtaining a distance. It ║
;;║ improves on the DIST commands in three ways. First, it║
;;║ checks each point and does not restart if an invalid ║
;;║ point is input. Second, it avoids having to flip to ║
;;║ the text screen to get a distance. Finally, it allows ║
;;║ several distances to be obtained without having to ║
;;║ reissue the command. ║
;;╚══════════════════════════════════════════════════════════════════════════╝
;;; ===================== load-time error checking ============================
;;;
(defun ai_abort (app msg)
(defun *error* (s)
(if old_error (setq *error* old_error))
(princ)
)
(if msg
(alert (strcat " Application error: "
app
" \n\n "
msg
" \n"
)
)
)
(exit)
)
;;; Check to see if AI_UTILS is loaded, If not, try to find it,
;;; and then try to load it.
;;;
;;; If it can't be found or it can't be loaded, then abort the
;;; loading of this file immediately, preserving the (autoload)
;;; stub function.
(cond
( (and ai_dcl (listp ai_dcl))) ; it's already loaded.
( (not (findfile "ai_utils.lsp")) ; find it
(ai_abort "DDDIST"
(strcat "Can't locate file AI_UTILS.LSP."
"\n Check support directory.")))
( (eq "failed" (load "ai_utils" "failed")) ; load it
(ai_abort "DDDIST" "Can't load file AI_UTILS.LSP"))
)
(if (not (ai_acadapp)) ; defined in AI_UTILS.LSP
(ai_abort "DDDIST" nil) ; a Nil <msg> supresses
) ; ai_abort's alert box dialog.
(defun C:DDDIST (/ dddist_pt1 dddist_pt2 id ddlist_again)
(setq *olderror* *error*)
(defun *error* (msg)
(princ msg)
(setq
*error* *olderror*
*olderror* nil
)
(princ)
)
;go until they pick first point
(while (=
(setq
dddist_pt1
(getpoint "\nFirst point: ")
)
nil
)
(prompt "\nInvalid point.")
)
;get second point with rubberband from first
(while (=
(setq
dddist_pt2
(getpoint dddist_pt1 "\nSecond point: ")
)
nil
)
(prompt "\nInvalid point.")
)
;set up the dialog identification
(setq id (load_dialog "dddist"))
;open dialog and store location as a global
(new_dialog "dddist" id "" #dddist_loc)
;set up the 2-D option
(if (/= #dddist_2d "1")
(set_tile "distance"
(strcat " Distance: "
(rtos (distance dddist_pt1 dddist_pt2))
)
)
(set_tile "distance"
(strcat " Distance (2D): "
(rtos (distance
(list (car dddist_pt1) (cadr dddist_pt2) 0)
(list (car dddist_pt2) (cadr dddist_pt2) 0)
)
)
)
)
)
;tile setup
(set_tile "angle"
(strcat "Angle in XY Plane: "
(angtos (angle
(list (car dddist_pt1) (cadr dddist_pt1) 0)
(list (car dddist_pt2) (cadr dddist_pt2) 0)
)
)
)
)
(set_tile "deltax"
(strcat " Delta X: "
(rtos (distance
(list (car dddist_pt1) 0 0)
(list (car dddist_pt2) 0 0)
)
)
)
)
(set_tile "deltay"
(strcat " Delta Y: "
(rtos (distance
(list 0 (cadr dddist_pt1) 0)
(list 0 (cadr dddist_pt2) 0)
)
)
)
)
(set_tile "deltaz"
(strcat " Delta Z: "
(rtos (distance
(list 0 0 (caddr dddist_pt1))
(list 0 0 (caddr dddist_pt2))
)
)
)
)
;reset to nil for check later
(setq dddist_again nil)
;highlight the 2D option if present
(if (= #dddist_2D "1")
(set_tile "2d" "1")
)
;set up callbacks
(action_tile "accept" "(setq #dddist_loc (done_dialog))")
(action_tile "2d" "(setq #dddist_2d $value)")
(action_tile "again" "(setq dddist_again T #dddist_loc (done_dialog))")
(start_dialog)
(unload_dialog id)
;do it again if necessary
(if dddist_again(C:DDDIST))
(prin1)
) ;defun dddist
;;================================ The End ===================================
(princ "DDDIST Loaded.")
(princ)